November 25, 2017

Selcuk Akbas

Bizim takım : Ipsos SMAP

Packages

library(tidyverse) # data proses, summary, table
library(reshape2) # data proses
library(plotly) # interaktif grafik
library(knitr) # rmarkdown
library(kableExtra) # güzel talo output
library(sjPlot) # ozel göserimler

R Kaynaklar

Araştırma Tasarımı

– Amaç

– Hedef Kitle

– Soru Formu

– Örnekleme

– Data Proses

– Analiz

– Raporlama

Örnekleme

  • Temsiliyet
  • Örneklem büyüklüğü
  • Örneklem Dağılımı

Örneklem Büyüklüğü

https://en.wikipedia.org/wiki/Margin_of_error

  • Örneklem büyüklüğü belirlenirken, maksimum hata payı prensibini kullanıyoruz
  • Hata payı, p değeri 0.5 olduğunda maksimuma ulaşır.
  • Bu yüzden formülde p değeri 0.5 alınır.

\[ z * \sqrt\frac{p * q}{n} \]

Maksimum Hata payi fonksiyonu

\[ z * \sqrt\frac{p * q}{n} \]

hata_payi <- function(Uzay = 55000000, Orneklem) {

  p <- 0.5
  q <- 1 - p
  
  if (  Orneklem / Uzay < 0.05) { # örneklem < %5Uzay
      MyHataPayi <- 1.96 * sqrt((p * q) / Orneklem)  
  } else { # örneklem > %5Uzay
      MyHataPayi <- (1.96 * sqrt((p * q) / Orneklem)) * 
                      sqrt( (Uzay - Orneklem) / (Uzay - 1))  
  }
MyHataPayi
}

Örneklem büyüdüğünde hata payi nasıl değişir ?

  • 50 ile 1000 arası örneklem büyüklüklerinin hata payı eğrisini çizmek istersek :
orn <- seq(50,1000, by = 10)
hp <- sapply(orn,  function(x) hata_payi(Orneklem = x) )
df <- data.frame(orn, hp)

gg <- ggplot(df, aes(x = orn, y = hp )) + 
  geom_point() + xlab("Örneklem") + ylab("Hata Payı") +
  labs(title = "Örnklemlem büyüklüğü ile hata payı ilişkisi"
       , subtitle = "Ters logaritmik ilişki vardir")
  • sonuç sonraki slide

ggplotly ile interaktif grafikler..

ggplotly(gg + theme_minimal())

Daha fazlası için

Soru Formu Hazırlama (10dk) – Örnek soru tipleri

Gerçek çalışmalardan örnek sorular üzerinden geçelim

Memnuniyet calismalari

Genel Memnuniyet

  • Memnuiyet / Genel görüş gibi sorular alt boyutlardan önce sorulmalı

Alt boyutlar

Açık uçlu sorular

Tek seçenek

  • Soru formunda seçenek numaraları mutlaka bulunmali

Ürün Kullanim calismalari

Kota sorusunu özellikle dikkat çekilmeli

Funnel dediğimiz ardışık sorular

Kullanım sıklığı sorusu

Likert ölçek ifade katılım sorusu

Markaya atıf soruları / binary cevap

Veri Setini Oluşturma (15dk) – Soru tipine göre veri giriş biçimi

Datayi okuyalım / Excel

  • Excel için en hızlı bağlantı bu şekilde
library(readxl)

dat <- read_xlsx("data/ornek_data.xlsx", sheet = "data", skip = 1)

names(dat)
##  [1] "anketid" "gm1"     "sys1"    "sys2"    "sys3"    "sys4"    "sys5"   
##  [8] "sys6"    "oneri"   "k1"      "t4"      "s1a"     "s1b"     "s1c"    
## [15] "s1d"     "s1e"     "s1f"     "s1g"     "c5d"     "c6"      "m2_01"  
## [22] "m2_02"   "m2_03"   "m2_04"   "m2_05"   "m2_06"   "m2_07"   "m2_08"  
## [29] "m2_09"   "m2_10"   "m2_11"   "m2_12"   "m2_13"   "m2_14"   "m2_15"  
## [36] "m2_16"   "k_01"    "k_02"    "k_03"    "k_04"    "k_05"    "k_06"   
## [43] "k_07"    "k_08"    "k_09"    "k_10"    "k_11"    "k_12"    "k_13"   
## [50] "bin1"    "bin2"    "bin3"    "num1"    "num2"

Datayi okuyalım / Clipboard - CopyPaste

  • Excel için en hızlı bağlantı bu şekilde
library(readxl)

dat <- read.table(file = "clipboard", sep = "\t"
                  , header=TRUE,stringsAsFactors = FALSE)

değişkenleri uygun sekilde tanimlamaliyiz

  • En sıkıcı bölüm

Ordinal değişkenler

xfac <- c("gm1", "sys1", "sys2", "sys3", "sys4", "sys5", "c5d","c6" )

dat[,xfac] <- dat[,xfac] %>% 
  lapply(function(x) factor(x, exclude = "99", ordered = T) )

Kategorik değişkenler

dat$sys6 <- factor(dat$sys6, levels=c(1,2,99)
                   , labels=c("Evet yaşadım"
                              ,"Hayır yaşamadım"
                              ,"Hatırlamıyorum") )

dat$k1 <- factor(dat$k1, levels=c(1:3)
                 , labels=c("Satış temsilcisi"
                            ,"Çağrı merkezi"
                            ,"İnternet şube") )

dat$t4 <- factor(dat$t4, levels=c(2,3)
                 , labels=c("25-29", "30-40"), ordered = T  )

Funnel sorusu, markalar

xmar <- c("s1a", "s1b", "s1c", "s1d", "s1e", "s1f", "s1g")

dat[,xmar] <- dat[,xmar] %>% 
  lapply(function(x) 
    factor(x, levels=c(1:13)
           , labels=c('Aroma' , 'Cappy' , 'Dimes' 
                      , 'Exotic' , 'Tamek' , 'Pinar' 
                      , 'Halk' , 'Ulker Icim' , 'Juss' 
                      , 'Meysu' , 'Meyoz' , 'Jucy' , 'Uludag') ) )

Likert ölçek, ordinal tanımlama

xmem <- c('m2_01' , 'm2_02' , 'm2_03' , 'm2_04' , 'm2_05' 
          , 'm2_06' , 'm2_07' , 'm2_08' , 'm2_09' , 'm2_10' 
          , 'm2_11' , 'm2_12' , 'm2_13' , 'm2_14' , 'm2_15' 
          , 'm2_16')

dat[,xmem] <- dat[,xmem] %>% 
  lapply(function(x) 
    factor(x, levels=c(1:5), 
           labels=c('Kesinlikle Katılmıyorum' 
                    , 'Katılmıyorum' 
                    , 'Ne Katılıyorum Ne Katılmıyor' 
                    , 'Katılıyorum' 
                    , 'Kesinlikle Katılıyorum')
           , ordered = T ) )

Datanın yapisina bakalim

str(dat[,1:20])
## Classes 'tbl_df', 'tbl' and 'data.frame':    100 obs. of  20 variables:
##  $ anketid: num  1 2 3 4 5 6 7 8 9 10 ...
##  $ gm1    : Ord.factor w/ 10 levels "1"<"2"<"3"<"4"<..: 3 6 2 10 4 6 7 6 6 5 ...
##  $ sys1   : Ord.factor w/ 10 levels "1"<"2"<"3"<"4"<..: 7 8 7 3 1 2 8 4 NA 10 ...
##  $ sys2   : Ord.factor w/ 10 levels "1"<"2"<"3"<"4"<..: 10 NA 8 4 3 9 6 4 2 6 ...
##  $ sys3   : Ord.factor w/ 10 levels "1"<"2"<"3"<"4"<..: 9 7 4 6 7 9 8 3 8 4 ...
##  $ sys4   : Ord.factor w/ 10 levels "1"<"2"<"3"<"4"<..: 3 5 2 10 1 9 9 10 3 NA ...
##  $ sys5   : Ord.factor w/ 10 levels "1"<"2"<"3"<"4"<..: 6 10 8 8 2 4 9 4 7 NA ...
##  $ sys6   : Factor w/ 3 levels "Evet yasadim",..: 1 1 2 2 1 1 2 2 3 1 ...
##  $ oneri  : chr  "perferendis doloribus asperiores repellat" "optio cumque nihil impedit quo" "saepe eveniet ut et voluptates" NA ...
##  $ k1     : Factor w/ 3 levels "Satis temsilcisi",..: 1 1 3 1 1 3 3 3 1 3 ...
##  $ t4     : Ord.factor w/ 2 levels "25-29"<"30-40": 2 2 2 2 1 1 2 2 2 1 ...
##  $ s1a    : Factor w/ 13 levels "Aroma","Cappy",..: 12 10 13 6 5 13 13 12 10 6 ...
##  $ s1b    : Factor w/ 13 levels "Aroma","Cappy",..: NA 1 2 1 2 2 2 2 NA 1 ...
##  $ s1c    : Factor w/ 13 levels "Aroma","Cappy",..: 3 3 4 4 4 4 4 3 3 3 ...
##  $ s1d    : Factor w/ 13 levels "Aroma","Cappy",..: 3 10 2 1 4 13 4 2 NA 6 ...
##  $ s1e    : Factor w/ 13 levels "Aroma","Cappy",..: 12 1 13 6 5 4 2 12 10 6 ...
##  $ s1f    : Factor w/ 13 levels "Aroma","Cappy",..: 12 3 13 1 4 4 13 3 NA 6 ...
##  $ s1g    : Factor w/ 13 levels "Aroma","Cappy",..: 12 3 2 4 5 4 4 3 10 6 ...
##  $ c5d    : Ord.factor w/ 8 levels "1"<"2"<"3"<"4"<..: 3 5 1 3 5 3 7 1 4 1 ...
##  $ c6     : Ord.factor w/ 5 levels "1"<"2"<"3"<"4"<..: 3 5 1 1 4 2 3 1 4 4 ...

Datanın yapisina bakalim

str(dat[,21:40])
## Classes 'tbl_df', 'tbl' and 'data.frame':    100 obs. of  20 variables:
##  $ m2_01: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 4 1 3 5 4 2 3 3 2 3 ...
##  $ m2_02: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 2 3 3 2 3 4 2 4 4 2 ...
##  $ m2_03: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 4 3 4 1 5 5 4 2 2 2 ...
##  $ m2_04: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 4 3 2 3 3 3 5 2 5 5 ...
##  $ m2_05: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 4 4 4 3 3 2 2 1 4 4 ...
##  $ m2_06: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 4 3 4 4 2 4 5 3 2 2 ...
##  $ m2_07: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 3 3 4 3 3 2 2 4 3 4 ...
##  $ m2_08: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 2 3 2 2 3 3 4 4 2 3 ...
##  $ m2_09: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 3 3 4 2 3 4 3 5 2 3 ...
##  $ m2_10: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 4 2 3 2 2 3 5 2 3 3 ...
##  $ m2_11: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 2 2 4 3 2 3 4 4 3 2 ...
##  $ m2_12: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 2 2 3 3 3 2 2 2 3 4 ...
##  $ m2_13: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 3 2 3 2 3 2 3 4 4 3 ...
##  $ m2_14: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 4 3 3 4 3 3 2 3 4 3 ...
##  $ m2_15: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 3 5 2 3 3 3 3 4 2 3 ...
##  $ m2_16: Ord.factor w/ 5 levels "Kesinlikle Katilmiyorum"<..: 2 4 2 2 3 4 3 3 2 4 ...
##  $ k_01 : chr  "33" "11,24,0" "7,11,24,33" "7,11,24,33" ...
##  $ k_02 : chr  "11,0" "7,24,0" "7,11,0" "24,0" ...
##  $ k_03 : chr  "7,11,0" "0" "0" "7,33" ...
##  $ k_04 : chr  "7,11,33" "11,33" "7,24,33" "7,11,24,33" ...

Tablolama (15dk)

Tablolama – Frekans, çapraz tablo

  • base R
with(dat, table(sys6, k1)) %>% 
  kable()
Satis temsilcisi Çagri merkezi Internet sube
Evet yasadim 20 14 14
Hayir yasamadim 17 16 16
Hatirlamiyorum 3 0 0

Tablolama – Frekans, çapraz tablo

  • dplyr way
dat %>%  
  group_by(sys6, k1) %>% 
  summarise(say = n()) %>% 
  spread(k1, say) %>% 
  kable(format = "markdown")
sys6 Satis temsilcisi Çagri merkezi Internet sube
Evet yasadim 20 14 14
Hayir yasamadim 17 16 16
Hatirlamiyorum 3 NA NA

Tablolama - ardışık soru

  • dplyr + reshape2 way
dat %>%  
  dplyr::select(anketid, s1a:s1g) %>% 
  melt(id.vars = "anketid", na.rm = T) %>%
  group_by(variable) %>% 
  mutate(s1baz = n_distinct(anketid) ) %>%  
  group_by(variable, value) %>%  
  summarise(s1_pay = n_distinct(anketid) / mean(s1baz) * 100) %>%  
  mutate(s1_pay = round(s1_pay,1)) %>% 
  spread(variable, s1_pay) -> xtables1

Tablolama - ardışık soru

  • dplyr + reshape2 way / soru bazli yüzde
## # A tibble: 13 x 8
##         value   s1a   s1b   s1c   s1d   s1e   s1f   s1g
##  *      <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
##  1      Aroma    NA  56.2    NA  15.6  14.6  15.7  11.2
##  2      Cappy    NA  43.8    NA  12.2  12.4   7.9  10.1
##  3      Dimes    NA    NA    36  12.2  12.4  16.9  13.5
##  4     Exotic    NA    NA    64  22.2  23.6  24.7  27.0
##  5       Halk    14    NA    NA   4.4   3.4   4.5   6.7
##  6       Jucy    13    NA    NA   4.4   9.0   5.6   4.5
##  7       Juss    18    NA    NA  10.0   6.7   6.7   6.7
##  8      Meyoz     8    NA    NA   2.2   3.4   3.4   4.5
##  9      Meysu    13    NA    NA   6.7   4.5   2.2   4.5
## 10      Pinar     9    NA    NA   5.6   3.4   2.2   2.2
## 11      Tamek     6    NA    NA    NA   2.2   3.4   4.5
## 12 Ulker Icim     4    NA    NA   1.1   1.1   1.1   1.1
## 13     Uludag    15    NA    NA   3.3   3.4   5.6   3.4

Tablolama likert with sjPlot

library(sjPlot) ; library(sjmisc) ; library(knitr)

dat %>%  
  dplyr::select(m2_01:m2_16) %>%
  sjt.stackfrq(show.n = TRUE, show.total = TRUE
               , show.skew = TRUE
               , show.kurtosis = TRUE
               , altr.row.col = TRUE)  

liker plot with sjPlot

İstatistiksel Hipotez Testleri

  • z, t, chi-square ve diğer.

  • En basit anlatımla Hipotez testi, dagilimlarin birbirini kesip kesmediğini analiz etmektir

Örneklem dağılımı

z-test - Ortalama

  • Örneklem ortalamasının, ana kütle ortalaması ile karşılaştırırız.

Ortalamalar Eşittir : \[ H_o: \mu = \mu_{0} \] \[ H_a: \mu \neq \mu_{0} \]

Ortalama 37'ye eşittir : \[ H_o: \mu = 37 \] \[ H_a: \mu \neq 37 \]

Test istatistiği : \[ z = \frac{\bar{x} - \mu_0}{\sigma/\sqrt{n}} \]

parametric tests

chi-square test

sjt.xtab(dat$sys6, dat$t4, show.row.prc = TRUE, 
         show.cell.prc = TRUE, show.legend = TRUE)

independent 2-group t-test

  • where y is numeric and x is a binary factor
# library(mosaic)
xt <- with(dat, t.test(num1~bin1)) 
xt
## 
##  Welch Two Sample t-test
## 
## data:  num1 by bin1
## t = -1.0682, df = 97.997, p-value = 0.2881
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.6156922  0.1848093
## sample estimates:
## mean in group 0 mean in group 1 
##        3.051013        3.266455
# xpt(q=xt$statistic, lower.tail=FALSE, df=99)

independent 2-group t-test

  • where y1 and y2 are numeric
xt <- with(dat, t.test(num1,num2)) 
xt
## 
##  Welch Two Sample t-test
## 
## data:  num1 and num2
## t = 2.1186, df = 195.81, p-value = 0.03539
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.01987015 0.55520749
## sample estimates:
## mean of x mean of y 
##  3.158734  2.871195
# xpt(q=xt$statistic, lower.tail=TRUE, df=99)

paired t-test

  • where y1 & y2 are numeric
xt <- with(dat, t.test(num1,num2, paired = T)) 
xt
## 
##  Paired t-test
## 
## data:  num1 and num2
## t = 2.0839, df = 99, p-value = 0.03975
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.01375288 0.56132476
## sample estimates:
## mean of the differences 
##               0.2875388

one sample t-test

  • Ho: mu=3
xt <- with(dat, t.test(num2,mu=3)) 
xt
## 
##  One Sample t-test
## 
## data:  num2
## t = -1.4192, df = 99, p-value = 0.159
## alternative hypothesis: true mean is not equal to 3
## 95 percent confidence interval:
##  2.691116 3.051275
## sample estimates:
## mean of x 
##  2.871195
# xpt(q=xt$statistic, lower.tail=TRUE, df=99)

anova

  • One Way Anova (Completely Randomized Design)
fit <- aov(num1 ~ factor(t4), data=dat)

# display Type I ANOVA table
summary(fit)
##             Df Sum Sq Mean Sq F value Pr(>F)
## factor(t4)   1   0.42  0.4217   0.412  0.523
## Residuals   98 100.40  1.0245

anova diagnostic plots

layout(matrix(c(1,2,3,4),2,2))
plot(fit)

anova Multiple Comparisons

# Multiple Comparisons
TukeyHSD(fit) # where fit comes from aov()
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = num1 ~ factor(t4), data = dat)
## 
## $`factor(t4)`
##                 diff        lwr       upr     p adj
## 30-40-25-29 0.130295 -0.2727279 0.5333178 0.5226521

Non-Parametric tests

  • Benim alanim degil ama örnekler hazırladım

independent 2-group Mann-Whitney U Test

  • where y is numeric and A is A binary factor
with(dat, wilcox.test(num1~bin1)) 
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  num1 by bin1
## W = 1144, p-value = 0.467
## alternative hypothesis: true location shift is not equal to 0

independent 2-group Mann-Whitney U Test

  • where y and x are numeric
with(dat, wilcox.test(num1,num2) )
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  num1 and num2
## W = 5715, p-value = 0.08085
## alternative hypothesis: true location shift is not equal to 0

dependent 2-group Wilcoxon Signed Rank Test

  • where y1 and y2 are numeric
with(dat, wilcox.test(num1,num2,paired=TRUE) )
## 
##  Wilcoxon signed rank test with continuity correction
## 
## data:  num1 and num2
## V = 3193, p-value = 0.02173
## alternative hypothesis: true location shift is not equal to 0

Kruskal Wallis Test One Way Anova by Ranks

  • where y1 is numeric and A is a factor
with(dat, kruskal.test(num1~factor(t4))) 
## 
##  Kruskal-Wallis rank sum test
## 
## data:  num1 by factor(t4)
## Kruskal-Wallis chi-squared = 0.56828, df = 1, p-value = 0.4509

Randomized Block Design - Friedman Test

  • where y are the data values, A is a grouping factor and B is a blocking factor
with(dat, friedman.test(num1~t4|sys1))